home *** CD-ROM | disk | FTP | other *** search
/ NetNews Offline 2 / NetNews Offline Volume 2.iso / news / comp / lang / rexx / 17 < prev    next >
Encoding:
Text File  |  1996-08-06  |  18.1 KB  |  457 lines
  1. Path: news-m01.ny.us.ibm.net!usenet
  2. From: husin@ibm.net
  3. Newsgroups: comp.lang.rexx
  4. Subject: Endless to download/run * CMS,TSO,Windows,more DOS support...
  5. Date: 2 Jan 1996 10:10:12 GMT
  6. Distribution: inet
  7. Message-ID: <4cb0a4$1j9g@news-s01.ny.us.ibm.net>
  8. Reply-To: husin@ibm.net
  9. NNTP-Posting-Host: slip37-241-66.ibm.net
  10. X-Newsreader: IBM NewsReader/2 v1.2.5
  11.  
  12. /* REXX */
  13. /*====================================================================*\
  14.                                 FREEWARE
  15.  
  16.                                 ENDLESS
  17.  
  18.                             A Multi-platform
  19.                              Execute-ready
  20.                            REXX Show Program
  21.  
  22.          Released and maintained by Simon Husin (husin@ibm.net)
  23.                           Version: 1996/01/02
  24. ========================================================================
  25. This program is based on the well-known 'Towers of Hanoi' problem.
  26.  
  27. It is created by Simon Husin to show REXX program's flexibility and
  28. portability.
  29.  
  30. You are encouraged to modify this program to make it run on your REXX
  31. engine.  To make sure that it is maintained properly, I am inviting you
  32. to send me your modifications which I will apply on my copy to release
  33. it back to (more) public.  To show my gratitudes, I will include your
  34. name and contribution(s) in the list of contributors below.
  35.  
  36. I thank you in advance for your interests and cooperations.
  37.  
  38. For latest news and releases, please read newsgroup 'comp.lang.rexx'!
  39. ------------------------------------------------------------------------
  40.                           List Of Contributors
  41.                     And Supported Platforms To-date
  42.  
  43. Hard-  Operating        REXX                YYYY/MM/DD
  44. Ware   System           Engine              Applied     Contributed By
  45. .......................................................................
  46. Intel+ IBM PC DOS 7.0   IBM PC DOS REXX     1995/12/25  Simon Husin
  47. Any?   Any PC/MS-DOS+   Quercus Systems     1995/12/25  Simon Husin
  48.                         Personal/REXX 3.0
  49. Intel+ IBM OS/2 & Warp  IBM PL/2 REXX       1995/12/25  Simon Husin
  50. Intel+ IBM OS/2 & Warp  Quercus Systems     1995/12/25  Simon Husin
  51.                         Personal/REXX 3.0
  52. Intel+ IBM OS/2 & Warp  IBM PL/2 REXX &     1995/12/27  Simon Husin
  53.        Under Tritus SPF Quercus P/REXX 3.0
  54. Any?   PC/MS-DOS+& ANSI Tritus SPF REXX     1995/12/27  Simon Husin
  55. Any?   PC/MS-DOS+& ANSI Regina REXX         1995/12/28  Mark Hessling
  56. Any?   Any Unix         Regina REXX         1995/12/28  Mark Hessling
  57. Any?   Any PC/MS-DOS+   Kilowatt Software   1995/12/29  Simon Husin
  58.                         Portable/REXX 1.x
  59. Any?   PC/MS-DOS+& ANSI BNV REXX 1.x        1995/12/30  Mathew Goldstein
  60. Any?   MS-Windows+ &    Quercus Systems     1996/01/01  Simon Husin
  61.        IBM-WinOS2       Personal/REXX 3.0
  62. Any?   MS-Windows+ &    Kilowatt Software   1995/01/01  Simon Husin
  63.        IBM-WinOS2       Portable/REXX 1.x
  64. Amiga  Amiga DOS        William Hawes       1995/01/01  Simon Husin
  65.        Release 2/newer  ARexx ?
  66. IBM370+VM/CMS           IBM REXX/370 ?      1995/01/01  Gil P.?
  67. IBM370+MVS-TSO/E        IBM REXX/370 ?      1995/01/02  Simon Husin
  68. .......................................................................
  69. Notes: + = Including compatibles
  70.        ? = Still waiting for (your) confirmation
  71. \*====================================================================*/
  72.  
  73. /*--------------------------------------------------------------------*\
  74.                    Check operating system environment
  75.    Initial system specific commands for local system interpret(ation)
  76. \*--------------------------------------------------------------------*/
  77. parse version interpreter version release
  78. interpreter = translate(interpreter)
  79. addr = translate(address())
  80. parse source env .
  81. gen.Footer = 'EndLess * OS-Env:'env'-'addr||,
  82.              ' * REXX Engine:'interpreter' V.'version' of 'release
  83. gen.Footer = center(strip(left(gen.Footer, 78)), 78)
  84.  
  85. select
  86.    when interpreter = 'REXX370' then do /* IBM Mainframe */
  87.         select
  88.           when addr = 'MVS' then
  89.                gen.Engine = 'IBMMVSREXX' /* MVS                       */
  90.           when addr = 'TSO' then do
  91.                if strip(sysvar('sysenv')) = 'FORE' then /* TSO/E      */
  92.                   gen.Engine = 'IBMTSOFOREREXX' /* Foreground         */
  93.                else
  94.                   gen.Engine = 'IBMTSOBATCHREXX' /* Batch             */
  95.                end
  96.           otherwise
  97.                gen.Engine = 'IBMVMREXX' /* VM/CMS                     */
  98.           end
  99.         end
  100.    when interpreter = 'UNI-REXX' then  /* Unix/AIX Workstation        */
  101.         gen.Engine = 'WRKUNIREXX'     /*The Workstation Group uni-REXX*/
  102.    when interpreter = 'REXXSAA' &,
  103.         addr = 'COMMAND' then do       /* New IBM REXX environment    */
  104.         if env = 'DOS' then
  105.            gen.Engine = 'IBMPCDOSREXX' /* IBM PC-DOS 7.x REXX         */
  106.         else
  107.            gen.Engine = 'IBMOS400REXX' /* IBM OS/400 REXX             */
  108.         end
  109.    when interpreter = 'REXXSAA' &,
  110.         addr = 'CMD' then              /* IBM PL 2/REXX               */
  111.         gen.Engine = 'IBMOS2REXX'
  112.    when interpreter = 'REXXSAA' &,
  113.         addr = 'ISPEXEC' then
  114.         gen.Engine = 'IBMOS2REXXTSPF'  /* IBM PL 2/REXX in Tritus SPF */
  115.    when interpreter = 'REXX/PERSONAL' then do /* Quercus Systems REXX */
  116.         if addr = 'CMD' then
  117.            gen.Engine = 'QUERCUSOS2REXX' /* under OS/2                */
  118.         else if addr = 'DOS' then
  119.            gen.Engine = 'QUERCUSDOSREXX' /* under PC/MS-DOS           */
  120.         else if addr = 'WINREXX' then
  121.            gen.Engine = 'QUERCUSWINREXX' /*under MS-Windows/IBM WinOS2*/
  122.         else if addr = 'ISPEXEC' then
  123.            gen.Engine = 'QUERCUSOS2REXXTSPF' /* Tritus SPF under OS/2 */
  124.         end
  125.    when left(interpreter, 9) = 'REXX-KILO' then /* PC/MS-DOS          */
  126.         gen.Engine = 'KILODOSREXX'   /*Kilowatt Software Portable/REXX*/
  127.    when left(interpreter, 9) = 'REXX/WIND' then /* Windows/Win-OS2    */
  128.         gen.Engine = 'KILOWINREXX'   /* Kilowatt Software REXX/Windows*/
  129.    when interpreter = 'REXX:OPEN-REXX179' then
  130.         gen.Engine = 'TRITUSDOSREXX' /* Tritus REXX under DOS TSPF    */
  131.    when interpreter = 'AREXX' then
  132.         gen.Engine = 'AMIGAREXX'     /* Amiga Micro Computer w/ ARexx */
  133.    when left(interpreter, 11) = 'REXX-REGINA' then
  134.         gen.Engine = 'REGINAREXX'    /* Regina REXX under UNIX or DOS */
  135.    when interpreter = 'REXX' & left(release, 3) = 'BNV' then
  136.         gen.Engine = 'BNVREXX'       /* BNV (?) REXX under PC/MS-DOS  */
  137.    otherwise
  138.         gen.Engine = 'UNKNOWNREXX'   /* Unknown OS/REXX environment   */
  139.    end
  140.  
  141. /*--------------------------------------------------------------------*\
  142.                Set engine- & platform-dependent features
  143. \*--------------------------------------------------------------------*/
  144. gen.ANSIesc   = d2c(27)||d2c(91)
  145.                              /* ANSI Esc char. + open bracket         */
  146. gen.Block     = ''           /* Block character for graphical present.*/
  147. gen.Clear     = "'CLS'"      /* To clear screen                       */
  148. gen.Console   = 'CON:'       /* Name of output device                 */
  149. gen.CursorOFF = 'NOP'        /* To hide the cursor during gr. present.*/
  150. gen.CursorON  = 'NOP'        /* To show the cursor after gr. present. */
  151. gen.DelayDur  = 'call DelayTime'
  152.                              /* Instruction/command to pause in moves */
  153. gen.Hanoi     = 'T'          /* Graphical or Textual presentation     */
  154. gen.MaxRow    = 24           /* Maximum number of rows on the screen  */
  155. gen.Q.Start   = ''           /* String w/ disk numbers on pole Start  */
  156. gen.Q.Temp    = ''           /* String w/ disk numbers on pole Temp   */
  157. gen.Q.Target  = ''           /* String w/ disk numbers on pole Target */
  158. gen.Start     = 1            /* 1st pole pos. for graphical present.  */
  159. gen.Steps     = 0            /* Disk movements needed to solve        */
  160. gen.Target    = 53           /* last pole pos. for graphical present. */
  161. gen.Temp      = 27           /* 2nd pole pos. for graphical present.  */
  162.  
  163. select
  164.   when left(gen.Engine, 10) = 'IBMOS2REXX' then do
  165.        call rxfuncadd 'sysloadfuncs', 'REXXUTIL', 'sysloadfuncs'
  166.        call sysloadfuncs
  167.        if right(gen.Engine, 4) = 'TSPF' then
  168.           gen.Clear  = 'ADDRESS CMD CLS'
  169.        gen.CursorOFF = "call syscurstate 'OFF'"
  170.        gen.CursorON  = "call syscurstate 'ON'"
  171.        gen.DelayDur  = 'call syssleep'
  172.        gen.Hanoi     = 'G'
  173.        end
  174.   when gen.Engine = 'IBMPCDOSREXX' then do
  175.        gen.Console   = 'CON'
  176.        gen.CursorOFF = "call rxcrstat 'OFF'"
  177.        gen.CursorON  = "call rxcrstat 'ON'"
  178.        gen.DelayDur  = 'call rxsleep'
  179.        gen.Hanoi     = 'G'
  180.        end
  181.   when gen.Engine = 'IBMTSOFOREREXX' then
  182.        gen.Clear  = "'CLRSCRN'"
  183.   when left(gen.Engine, 14) = 'QUERCUSDOSREXX' |,
  184.        left(gen.Engine, 14) = 'QUERCUSOS2REXX' then do
  185.        if right(gen.Engine, 4) = 'TSPF' then
  186.           gen.Clear  = 'ADDRESS CMD CLS'
  187.        gen.DelayDur  = 'call delay'
  188.        gen.Hanoi     = 'G'
  189.        end
  190.   when gen.Engine    = 'QUERCUSWINREXX' then
  191.        gen.DelayDur  = 'call delay'
  192.   when gen.Engine = 'REGINAREXX' then do
  193.        gen.Block     = '*'
  194.        gen.Clear     = 'call UnixClear'
  195.        gen.Console   = '/dev/tty'
  196.        gen.DelayDur  = 'call UnixSleep'
  197.        gen.MaxRow    = 23
  198.        gen.Hanoi     = 'G'
  199.        end
  200.   when gen.Engine = 'TRITUSDOSREXX' then do
  201.        gen.Clear     = 'ADDRESS CMD CLS'
  202.        gen.Console   = 'CON'
  203.        gen.Hanoi     = 'G'
  204.        end
  205.   when gen.Engine = 'KILODOSREXX' then do
  206.        gen.Console   = '!'
  207.        gen.DelayDur  = 'call delay'
  208.        gen.Hanoi     = 'G'
  209.        end
  210.   when gen.Engine = 'KILOWINREXX' then
  211.        gen.DelayDur  = 'call delay'
  212.   when gen.Engine = 'AMIGAREXX' then do
  213.        gen.Block     = '*'
  214.        gen.Console   = 'STDOUT'
  215.        gen.Clear     = 'call writech' gen.Console',' gen.ANSIesc'2J'
  216.        gen.DelayDur  = 'call delay'
  217.        gen.Hanoi     = 'G'
  218.        end
  219.   when gen.Engine = 'IBMVMREXX' then do
  220.        gen.Block     = '*'
  221.        gen.Clear     = "ADDRESS 'COMMAND' VMFCLEAR"
  222.        gen.Console   = ''
  223.        gen.DelayDur = "CALL diagRC 8, 'SLEEP' DELAY 'SEC'"
  224.        end
  225.   otherwise
  226.        nop
  227.   end
  228.  
  229. if gen.Hanoi = 'G' then do
  230.    if gen.Block = '' then gen.Block = d2c(240)
  231.    gen.MaxRowMin = gen.MaxRow - 1
  232.    end
  233.  
  234. /*--------------------------------------------------------------------*\
  235.                   Request number of disks to play with
  236. \*--------------------------------------------------------------------*/
  237. interpret gen.Clear
  238. say 'Please enter the number of disks to play with:'
  239. say '(if not entered, or entered but wrong it will be set to 3)'
  240. pull gen.Disks
  241. if datatype(gen.Disks) = 'NUM' then
  242.    nop
  243. else
  244.    gen.Disks = 3
  245. gen.Disks = gen.Disks % 1
  246. if gen.Disks < 1 then gen.Disks = 3
  247.  
  248. /*--------------------------------------------------------------------*\
  249.           Request for delay in seconds between disk movements
  250. \*--------------------------------------------------------------------*/
  251. say 'Please enter delay factor in seconds:'
  252. say '(if not entered, '||,
  253.     'or entered but unacceptable it will be set to 2 sec.)'
  254. pull gen.Delay
  255. if datatype(gen.Delay) = 'NUM' then
  256.    nop
  257. else
  258.    gen.Delay = 2
  259. gen.Delay = gen.Delay % 1
  260. if gen.Delay < 0 | gen.Delay > 99 then gen.Delay = 2
  261. gen.DelayDur  = gen.DelayDur gen.Delay
  262.  
  263. /*--------------------------------------------------------------------*\
  264.                Put as many disks as requested in 'START'
  265. \*--------------------------------------------------------------------*/
  266. do ix = 1 to gen.Disks
  267.    gen.Q.Start = gen.Q.Start ix
  268.    end
  269. gen.Q.Start = strip(gen.Q.Start)
  270.  
  271. /*--------------------------------------------------------------------*\
  272.            Start the real presentation and recursive process
  273. \*--------------------------------------------------------------------*/
  274. call time 'R'
  275. timestarted = time()
  276. if gen.Hanoi = 'T' then
  277.    call Hanoi gen.Disks, 'START', 'TEMP', 'TARGET'
  278. else do
  279.    interpret gen.Clear
  280.    interpret gen.CursorOFF
  281.    call GStart gen.Disks
  282.    call GHanoi gen.Disks, 'START', 'TEMP', 'TARGET'
  283.    interpret gen.CursorON
  284.    end
  285.  
  286. /*--------------------------------------------------------------------*\
  287.                         Show process statistics
  288. \*--------------------------------------------------------------------*/
  289. call CursorSet 1, 1
  290. say
  291. say 'Process started at' timestarted'.  It is now' time()'.'
  292. say 'It took' gen.Steps 'moves to solve with' gen.Disks 'disks.'
  293. say 'Total duration' time('E') / 1 'seconds,'
  294. say ' with' gen.Delay 'seconds delay for each move.'
  295. return
  296.  
  297. /*--------------------------------------------------------------------*\
  298.                 Recursive Process (textual presentation)
  299. \*--------------------------------------------------------------------*/
  300. Hanoi: procedure expose gen.
  301. parse arg disks, start, temp, target
  302. disks = strip(disks)
  303. if disks = 1 then
  304.    say 'Move disk#' DiskMove(start, target) ||,
  305.        ' from' left(start, 6) 'to' target
  306. else do
  307.    call Hanoi (disks - 1), start, target, temp
  308.    say 'Move disk#' DiskMove(start, target) ||,
  309.        ' from' left(start, 6) 'to' target
  310.    call Hanoi (disks - 1), temp, start, target
  311.    end
  312. return
  313.  
  314. /*--------------------------------------------------------------------*\
  315.       Move a disk from one pole to another (textual presentation)
  316. \*--------------------------------------------------------------------*/
  317. DiskMove: procedure expose gen.
  318. parse arg start, target
  319. if gen.Delay > 0 then interpret gen.DelayDur
  320. parse var gen.Q.Start disknum gen.Q.Start
  321. gen.Q.Target = disknum gen.Q.Target
  322. gen.Steps = gen.Steps + 1
  323. return right(disknum, 3)
  324.  
  325. /*--------------------------------------------------------------------*\
  326.                          Show the starting pile
  327. \*--------------------------------------------------------------------*/
  328. GStart: procedure expose gen.
  329. arg disks
  330. if disks < gen.MaxRow - 2 then
  331.    row = gen.MaxRow - 2 - disks
  332. else
  333.    row = 0
  334. call XYString gen.MaxRow, gen.Start, gen.Console, gen.Footer
  335. call XYString gen.MaxRowMin, gen.Start,,
  336.               gen.Console, center('Start',  24, gen.block)
  337. call XYString gen.MaxRowMin, gen.Temp,,
  338.               gen.Console, center('Temp',   24, gen.block)
  339. call XYString gen.MaxRowMin, gen.Target,,
  340.               gen.Console, center('Target', 24, gen.block)
  341.  
  342. do ix = disks to 1 by -1
  343.    call XYString (row + ix), 1,,
  344.                  gen.Console, center(center(ix, ix, gen.block), 24)
  345.    end
  346. return
  347.  
  348. /*--------------------------------------------------------------------*\
  349.           Recursive Process (primitive graphical presentation)
  350. \*--------------------------------------------------------------------*/
  351. GHanoi: procedure expose gen.
  352. parse arg disks, start, temp, target
  353. disks = strip(disks)
  354. if disks = 1 then
  355.    call GDiskMove start, target
  356. else do
  357.    call GHanoi (disks - 1), start, target, temp
  358.    call GDiskMove start, target
  359.    call GHanoi (disks - 1), temp, start, target
  360.    end
  361. return
  362.  
  363. /*--------------------------------------------------------------------*\
  364. Move a disk from one pole to another (primitive graphical presentation)
  365. \*--------------------------------------------------------------------*/
  366. GDiskMove: procedure expose gen.
  367. parse arg start, target
  368. if gen.Delay > 0 then interpret gen.DelayDur
  369. call XYString (gen.MaxRowMin - words(gen.Q.Start)), gen.Start,,
  370.               gen.Console, '                        '
  371. parse var gen.Q.Start disknum gen.Q.Start
  372. gen.Q.Target = disknum gen.Q.Target
  373. call XYString (gen.MaxRowMin - words(gen.Q.Target)), gen.target,,
  374.               gen.Console, center(center(disknum,disknum,gen.block),24)
  375. gen.Steps = gen.Steps + 1
  376. return
  377.  
  378. /*--------------------------------------------------------------------*\
  379.   General routine to write a string at a specified position on screen
  380. \*--------------------------------------------------------------------*/
  381. XYString: procedure expose gen.
  382. parse arg row, col, device, data
  383. if gen.Engine = 'BNVREXX' then
  384.    say gen.ANSIesc||row';'col'H'data
  385. else do
  386.    call CursorSet row, col
  387.    call XCharout device, data
  388.    end
  389. return
  390.  
  391. /*--------------------------------------------------------------------*\
  392.          Set the cusor on the screen at the specified location
  393. \*--------------------------------------------------------------------*/
  394. CursorSet: procedure expose gen.
  395. parse arg row, col
  396. select
  397.   when gen.Engine = 'AMIGAREXX'      then call ANSIcursor row, col
  398.   when gen.Engine = 'BNVREXX'        then say gen.ANSIesc||row';'col'H'
  399.   when gen.Engine = 'IBMOS2REXX'     then call syscurpos row, col
  400.   when gen.Engine = 'IBMOS2REXXTSPF' then call syscurpos row, col
  401.   when gen.Engine = 'IBMPCDOSREXX'   then call rxsetpos  row, col
  402.   when gen.Engine = 'KILODOSREXX'    then call cursor row, col
  403.   when gen.Engine = 'QUERCUSDOSREXX' then call cursor row, col
  404.   when gen.Engine = 'QUERCUSOS2REXX' then call cursor row, col
  405.   when gen.Engine = 'QUERCUSOS2REXXTSPF' then call cursor row, col
  406.   when gen.Engine = 'REGINAREXX'     then call ANSIcursor row, col
  407.   when gen.Engine = 'TRITUSDOSREXX'  then call ANSIcursor row, col
  408.   otherwise nop
  409.   end
  410. return
  411.  
  412. /*--------------------------------------------------------------------*\
  413.        General routine to write a string of characters to screen
  414. \*--------------------------------------------------------------------*/
  415. XCharout: procedure expose gen.
  416. parse arg device, data
  417. if gen.Engine = 'AMIGAREXX' then
  418.    call writech device, data
  419. else
  420.    call charout device, data
  421. return
  422.  
  423. /*--------------------------------------------------------------------*\
  424.     Internal function to use ANSI escape sequence to position cursor
  425. \*--------------------------------------------------------------------*/
  426. ANSICursor: procedure expose gen.
  427. parse arg row, col
  428. call XCharout gen.Console, gen.ANSIesc||row';'col'H'
  429. return
  430.  
  431. /*--------------------------------------------------------------------*\
  432.                 Internal functions to call Unix commands
  433. \*--------------------------------------------------------------------*/
  434. UnixClear: procedure expose gen.
  435. Address System 'clear'
  436. return
  437.  
  438. UnixSleep: procedure expose gen.
  439. parse arg seconds
  440. Address System 'sleep' seconds
  441. return
  442.  
  443. /*--------------------------------------------------------------------*\
  444.                   Internal function to simulate delay
  445. \*--------------------------------------------------------------------*/
  446. DelayTime: procedure
  447. parse arg delay
  448. start= time('S')
  449. now  = start
  450. done = start + delay
  451. do until now >= done
  452.    now = time('S')
  453.    if now < start then now = now + 86400
  454.    end
  455. return
  456.  
  457.